#!/usr/bin/perl -w
package CPReport;
use warnings;
use strict;

# =========================================================
# compare mode
# =========================================================

our @compare_ops = (
    [ qw( >= <  ) ], # 2'b00
    [ qw( <= >  ) ], # 2'b01
    [ qw( >  <= ) ], # 2'b10
    [ qw( <  >= ) ], # 2'b11
);

our @compare_subs;
for my $m (0 .. 3) {
    my ($op0, $op1) = @{ $compare_ops[$m] };
    my $code_templ = 'sub { $_[0] %COMP% $_[1]; }';
    (my $code0 = $code_templ) =~ s/\%COMP\%/$op0/;
    (my $code1 = $code_templ) =~ s/\%COMP\%/$op1/;
    $compare_subs[$m] = [
        eval($code0),
        eval($code1),
    ];
}

our @sort_subs;

### numerical sort subs
for my $m (0 .. 3) {
    my ($op0, $op1) = @{ $compare_ops[$m] };
    my $edge_index  = $m & 1 ? '$#$ranges' : 0;
    my $reverse     = $m & 1 ? ''          : 'reverse';
    my $code = <<"EO_CODE";
sub {
    my (\$value, \$ranges) = \@_;
    if ( \$value $op1 \$ranges->[$edge_index] ) {
        return scalar(\@\$ranges);
    } else {
        for my \$i ($reverse(0 .. \$\#\$ranges)) {
            return \$i if \$value $op0 \$ranges->[\$i];
        }
    }
    die("range sorting code: can't reach here");
}
EO_CODE
    $sort_subs[$m] = eval($code);
    error("cannot eval the code: " . $@) if ($@);
}

### string sort subs
$sort_subs[4] = sub {
    my ($value, $ranges) = @_;
    for my $i (0 .. $#$ranges) {
        return $i if $value eq $ranges->[$i];
    }
    return scalar(@$ranges);
};

sub get_range_sort_sub {
    my ($mode) = @_;
    return $sort_subs[4] if ($mode & 4);
    return $sort_subs[$mode & 3];
}

sub get_range_desc {
    my ($mode, $ranges) = @_;
    if ($mode & 4) {
        return [ @$ranges ];
    }
    $mode &= 3;
    my $ops = $compare_ops[$mode];
    my @desc;
    push @desc, "$ops->[1] $ranges->[0]" unless ($mode & 1);
    for my $i (0 .. $#$ranges) {
        push @desc, "$ops->[0] $ranges->[$i]";
    }
    push @desc, "$ops->[1] $ranges->[$#$ranges]" if ($mode & 1);
    return \@desc;
}

sub read_pf {
    my ($filename) = @_;
    my @pf_list;
    my ($pass, $fail, $total) = (0, 0, 0);
    open PF_LIST, '<', $filename or error("cannot open file: $filename: $!");
    while (<PF_LIST>) {
        chomp;
        if (/^(\d+)\D+(\d+)[^\d\"]+\"?(\w+)\"?/) {
            my ($xadr, $yadr, $pf) = ($1, $2, $3);
            if ($pf =~ /^P/i) {
                $pf = 'P';
                $pass++;
            } else {
                $pf = 'F';
                $fail++;
            }
            $total++;
            push @pf_list, [$xadr, $yadr, $pf];
        }
    }
    close PF_LIST;
    error("Pass + Fail != Total?") unless ($pass + $fail == $total);
    SimpleError::message("PF from file '$filename':");
    SimpleError::message("  Pass : $pass");
    SimpleError::message("  Fail : $fail");
    SimpleError::message("  Total: $total");
    return (\@pf_list, +{
        Pass  => $pass,
        Fail  => $fail,
        Total => $total,
    });
}

# =========================================================
# miscellany
# =========================================================

sub check_output_file {
    my ($name) = @_;
    if (-f $name) {
        warning("$name: output file already exists!");
        return 1;
    } else {
        return 0;
    }
}

1;
